home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT21.ZIP / TUTPRO21.PAS < prev   
Pascal/Delphi Source File  |  1996-04-16  |  26KB  |  1,088 lines
  1. {$X+}
  2. USES Crt,GFX3;
  3.  
  4. CONST VGA = $A000;
  5.       maxpolys = 18;
  6.  
  7.             A : Array [1..maxpolys,1..4,1..3] of integer =
  8.         (
  9.          ((-10, -10, 10 ),
  10.           (10 , -10, 10 ),
  11.           (10 , 10 , 10 ),
  12.           (-10, 10 , 10 )),
  13.  
  14.          ((-10, 10 , -10),
  15.           (10 , 10 , -10),
  16.           (10 , -10, -10),
  17.           (-10, -10, -10)),
  18.  
  19.          ((-10, 10 , 10 ),
  20.           (-10, 10 , -10),
  21.           (-10, -10, -10),
  22.           (-10, -10, 10 )),
  23.  
  24.          ((10 , -10, 10 ),
  25.           (10 , -10, -10),
  26.           (10 , 10 , -10),
  27.           (10 , 10 , 10 )),
  28.  
  29.          ((10 , 10 , 10 ),
  30.           (10 , 10 , -10),
  31.           (-10, 10 , -10),
  32.           (-10, 10 , 10 )),
  33.  
  34.          ((-10, -10, 10 ),
  35.           (-10, -10, -10),
  36.           (10 , -10, -10),
  37.           (10 , -10, 10 )),
  38.  
  39. (*********)
  40.  
  41.          ((-10, -10,-20 ),
  42.           (10 , -10,-20 ),
  43.           (10 , 10 ,-20 ),
  44.           (-10, 10 ,-20 )),
  45.  
  46.          ((-10, 10 , -30),
  47.           (10 , 10 , -30),
  48.           (10 , -10, -30),
  49.           (-10, -10, -30)),
  50.  
  51.          ((-10, 10 ,-20 ),
  52.           (-10, 10 , -30),
  53.           (-10, -10, -30),
  54.           (-10, -10,-20 )),
  55.  
  56.          ((10 , -10,-20 ),
  57.           (10 , -10, -30),
  58.           (10 , 10 , -30),
  59.           (10 , 10 ,-20 )),
  60.  
  61.          ((10 , 10 ,-20 ),
  62.           (10 , 10 , -30),
  63.           (-10, 10 , -30),
  64.           (-10, 10 ,-20 )),
  65.  
  66.          ((-10, -10,-20 ),
  67.           (-10, -10, -30),
  68.           (10 , -10, -30),
  69.           (10 , -10,-20 )),
  70.  
  71. (*********)
  72.  
  73.          ((-30, -10, 10 ),
  74.           (-20, -10, 10 ),
  75.           (-20, 10 , 10 ),
  76.           (-30, 10 , 10 )),
  77.  
  78.          ((-30, 10 , -10),
  79.           (-20, 10 , -10),
  80.           (-20, -10, -10),
  81.           (-30, -10, -10)),
  82.  
  83.          ((-30, 10 , 10 ),
  84.           (-30, 10 , -10),
  85.           (-30, -10, -10),
  86.           (-30, -10, 10 )),
  87.  
  88.          ((-20, -10, 10 ),
  89.           (-20, -10, -10),
  90.           (-20, 10 , -10),
  91.           (-20, 10 , 10 )),
  92.  
  93.          ((-20, 10 , 10 ),
  94.           (-20, 10 , -10),
  95.           (-30, 10 , -10),
  96.           (-30, 10 , 10 )),
  97.  
  98.          ((-30, -10, 10 ),
  99.           (-30, -10, -10),
  100.           (-20, -10, -10),
  101.           (-20, -10, 10 ))
  102.         );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
  103.             { (X2,Y2,Z2) ... for the 4 points of a poly }
  104.  
  105.       XOfs = 100;
  106.       YOfs = 160;
  107.  
  108.  
  109. Type Point = Record
  110.                x,y,z:integer;                { The data on every point we rotate}
  111.              END;
  112.  
  113.      Pictype = array [0..127,0..127] of byte;
  114.  
  115.  
  116. VAR Lines : Array [1..maxpolys,1..4] of Point; { The base object to be rotated }
  117.     Translated : Array [1..maxpolys,1..4] of Point; { The rotated object }
  118.     centre, tcentre : Array [1..maxpolys] of Point;
  119.     Order : Array[1..maxpolys] of integer;
  120.     lookup : Array [0..360,1..2] of integer; { Our sin and cos lookup table }
  121.     poly : array [0..199,1..2] of integer;
  122.     ytopclip,ybotclip:integer;  {where to clip our polys to}
  123.     xoff,yoff,zoff:integer;
  124.  
  125.     pic : ^pictype;
  126.     lefttable : array [-200..400,0..2] of integer;
  127.     righttable : array [-200..400,0..2] of integer;
  128.  
  129.  
  130. {──────────────────────────────────────────────────────────────────────────}
  131. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  132. BEGIN
  133.   asm
  134.      mov        ax,0013h
  135.      int        10h
  136.   end;
  137. END;
  138.  
  139.  
  140. {──────────────────────────────────────────────────────────────────────────}
  141. Procedure Hline (x1,x2,y:integer;col:byte;where:word); assembler;
  142.   { This draws a horizontal line from x1 to x2 on line y in color col }
  143. asm
  144.   mov   ax,x1
  145.   cmp   ax,0
  146.   jge   @X1Okay
  147.   mov   x1,0
  148. @X1Okay :
  149.  
  150.   mov   ax,x2
  151.   cmp   ax,319
  152.   jle   @X2Okay
  153.   mov   x2,319
  154. @X2Okay :
  155.  
  156.   mov   ax,x1
  157.   cmp   ax,x2
  158.   jg    @Exit
  159.  
  160.   mov   ax,where
  161.   mov   es,ax
  162.   mov   ax,y
  163.   mov   di,ax
  164.   shl   ax,8
  165.   shl   di,6
  166.   add   di,ax
  167.   add   di,x1
  168.  
  169.   mov   al,col
  170.   mov   ah,al
  171.   mov   cx,x2
  172.   sub   cx,x1
  173.   shr   cx,1
  174.   jnc   @start
  175.   stosb
  176. @Start :
  177.   rep   stosw
  178. @Exit :
  179. end;
  180.  
  181.  
  182. {──────────────────────────────────────────────────────────────────────────}
  183. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  184.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  185.     in color col }
  186. var miny,maxy:integer;
  187.     loop1:integer;
  188.  
  189. Procedure doside (x1,y1,x2,y2:integer);
  190.   { This scans the side of a polygon and updates the poly variable }
  191. VAR temp:integer;
  192.     x,xinc:integer;
  193.     loop1:integer;
  194. BEGIN
  195.   if y1=y2 then exit;
  196.   if y2<y1 then BEGIN
  197.     temp:=y2;
  198.     y2:=y1;
  199.     y1:=temp;
  200.     temp:=x2;
  201.     x2:=x1;
  202.     x1:=temp;
  203.   END;
  204.   xinc:=((x2-x1) shl 7) div (y2-y1);
  205.   x:=x1 shl 7;
  206.   for loop1:=y1 to y2 do BEGIN
  207.     if (loop1>(ytopclip)) and (loop1<(ybotclip)) then BEGIN
  208.       if (x shr 7<poly[loop1,1]) then poly[loop1,1]:=x shr 7;
  209.       if (x shr 7>poly[loop1,2]) then poly[loop1,2]:=x shr 7;
  210.     END;
  211.     x:=x+xinc;
  212.   END;
  213. END;
  214.  
  215. begin
  216.   asm
  217.     mov   si,offset poly
  218.     mov   cx,200
  219. @Loop1:
  220.     mov   ax,32766
  221.     mov   ds:[si],ax
  222.     inc   si
  223.     inc   si
  224.     mov   ax,-32767
  225.     mov   ds:[si],ax
  226.     inc   si
  227.     inc   si
  228.     loop  @loop1
  229.   end;     { Setting the minx and maxx values to extremes }
  230.   miny:=y1;
  231.   maxy:=y1;
  232.   if y2<miny then miny:=y2;
  233.   if y3<miny then miny:=y3;
  234.   if y4<miny then miny:=y4;
  235.   if y2>maxy then maxy:=y2;
  236.   if y3>maxy then maxy:=y3;
  237.   if y4>maxy then maxy:=y4;
  238.   if miny<ytopclip then miny:=ytopclip;
  239.   if maxy>ybotclip then maxy:=ybotclip;
  240.   if (miny>199) or (maxy<0) then exit;
  241.  
  242.   Doside (x1,y1,x2,y2);
  243.   Doside (x2,y2,x3,y3);
  244.   Doside (x3,y3,x4,y4);
  245.   Doside (x4,y4,x1,y1);
  246.  
  247.   for loop1:= miny to maxy do
  248.     hline (poly[loop1,1],poly[loop1,2],loop1,color,where);
  249. end;
  250.  
  251.  
  252. {──────────────────────────────────────────────────────────────────────────}
  253. Procedure SetUpPoints;
  254.   { This creates the lookup table }
  255. VAR loop1,loop2:integer;
  256. BEGIN
  257.   For loop1:=0 to 360 do BEGIN
  258.     lookup [loop1,1]:=round(sin (rad (loop1))*16384);
  259.     lookup [loop1,2]:=round(cos (rad (loop1))*16384);
  260.   END;
  261.   For loop1:=1 to maxpolys do BEGIN
  262.     centre[loop1].x := (lines[loop1,1].x + lines[loop1,2].x +
  263.                         lines[loop1,3].x + lines[loop1,4].x) div 4;
  264.     centre[loop1].y := (lines[loop1,1].y + lines[loop1,2].y +
  265.                         lines[loop1,3].y + lines[loop1,4].y) div 4;
  266.     centre[loop1].z := (lines[loop1,1].z + lines[loop1,2].z +
  267.                         lines[loop1,3].z + lines[loop1,4].z) div 4;
  268.   END;
  269. END;
  270.  
  271. Procedure LoadGFX;
  272.   { This loads up our texture }
  273. VAR f1 : File;
  274.     bob : array [0..255, 1..3] of byte;
  275.     loop1 : Integer;
  276. BEGIN
  277.   getmem (pic,sizeof(pic^));
  278.   loadcel ('side1.cel',pic);
  279.  
  280.   assign (f1, 'side1.cel');
  281.   reset (f1, 1);
  282.   seek (f1, 32);
  283.   blockread (f1, bob, 768);
  284.   close (f1);
  285.   for loop1:=0 to 255 do
  286.     Pal (loop1, bob[loop1,1], bob[loop1,2], bob[loop1,3]);
  287. END;
  288.  
  289.  
  290. {──────────────────────────────────────────────────────────────────────────}
  291. Procedure RotatePoints (x,Y,z:Integer);
  292.   { This rotates the objecct in lines to translated }
  293. VAR loop1,loop2:integer;
  294.     a,b,c:integer;
  295. BEGIN
  296.   For loop1:=1 to maxpolys do BEGIN
  297.     for loop2:=1 to 4 do BEGIN
  298.       b:=lookup[y,2];
  299.       c:=lines[loop1,loop2].x;
  300.       asm
  301.         mov   ax,b
  302.         imul  c
  303.         sal   ax,1
  304.         rcl   dx,1
  305.         sal   ax,1
  306.         rcl   dx,1
  307.         mov   a,dx
  308.       end;
  309.       b:=lookup[y,1];
  310.       c:=lines[loop1,loop2].z;
  311.       asm
  312.         mov   ax,b
  313.         imul  c
  314.         sal   ax,1
  315.         rcl   dx,1
  316.         sal   ax,1
  317.         rcl   dx,1
  318.         add   a,dx
  319.       end;
  320.       translated[loop1,loop2].x:=a;
  321.       translated[loop1,loop2].y:=lines[loop1,loop2].y;
  322.       b:=-lookup[y,1];
  323.       c:=lines[loop1,loop2].x;
  324.       asm
  325.         mov   ax,b
  326.         imul  c
  327.         sal   ax,1
  328.         rcl   dx,1
  329.         sal   ax,1
  330.         rcl   dx,1
  331.         mov   a,dx
  332.       end;
  333.       b:=lookup[y,2];
  334.       c:=lines[loop1,loop2].z;
  335.       asm
  336.         mov   ax,b
  337.         imul  c
  338.         sal   ax,1
  339.         rcl   dx,1
  340.         sal   ax,1
  341.         rcl   dx,1
  342.         add   a,dx
  343.       end;
  344.       translated[loop1,loop2].z:=a;
  345.  
  346.  
  347.       if x<>0 then BEGIN
  348.         b:=lookup[x,2];
  349.         c:=translated[loop1,loop2].y;
  350.         asm
  351.           mov   ax,b
  352.           imul  c
  353.           sal   ax,1
  354.           rcl   dx,1
  355.           sal   ax,1
  356.           rcl   dx,1
  357.           mov   a,dx
  358.         end;
  359.         b:=lookup[x,1];
  360.         c:=translated[loop1,loop2].z;
  361.         asm
  362.           mov   ax,b
  363.           imul  c
  364.           sal   ax,1
  365.           rcl   dx,1
  366.           sal   ax,1
  367.           rcl   dx,1
  368.           sub   a,dx
  369.         end;
  370.         b:=lookup[x,1];
  371.         c:=translated[loop1,loop2].y;
  372.         translated[loop1,loop2].y:=a;
  373.         asm
  374.           mov   ax,b
  375.           imul  c
  376.           sal   ax,1
  377.           rcl   dx,1
  378.           sal   ax,1
  379.           rcl   dx,1
  380.           mov   a,dx
  381.         end;
  382.         b:=lookup[x,2];
  383.         c:=translated[loop1,loop2].z;
  384.         asm
  385.           mov   ax,b
  386.           imul  c
  387.           sal   ax,1
  388.           rcl   dx,1
  389.           sal   ax,1
  390.           rcl   dx,1
  391.           add   a,dx
  392.         end;
  393.         translated[loop1,loop2].z:=a;
  394.       END;
  395.  
  396.  
  397.  
  398.  
  399.       if z<>0 then BEGIN
  400.         b:=lookup[z,2];
  401.         c:=translated[loop1,loop2].x;
  402.         asm
  403.           mov   ax,b
  404.           imul  c
  405.           sal   ax,1
  406.           rcl   dx,1
  407.           sal   ax,1
  408.           rcl   dx,1
  409.           mov   a,dx
  410.         end;
  411.         b:=lookup[z,1];
  412.         c:=translated[loop1,loop2].y;
  413.         asm
  414.           mov   ax,b
  415.           imul  c
  416.           sal   ax,1
  417.           rcl   dx,1
  418.           sal   ax,1
  419.           rcl   dx,1
  420.           sub   a,dx
  421.         end;
  422.         b:=lookup[z,1];
  423.         c:=translated[loop1,loop2].x;
  424.         translated[loop1,loop2].x:=a;
  425.         asm
  426.           mov   ax,b
  427.           imul  c
  428.           sal   ax,1
  429.           rcl   dx,1
  430.           sal   ax,1
  431.           rcl   dx,1
  432.           mov   a,dx
  433.         end;
  434.         b:=lookup[z,2];
  435.         c:=translated[loop1,loop2].y;
  436.         asm
  437.           mov   ax,b
  438.           imul  c
  439.           sal   ax,1
  440.           rcl   dx,1
  441.           sal   ax,1
  442.           rcl   dx,1
  443.           add   a,dx
  444.         end;
  445.         translated[loop1,loop2].y:=a;
  446.       END;
  447.     END;
  448.   END;
  449.  
  450.  
  451. {******************}
  452.   For loop1:=1 to maxpolys do BEGIN
  453.     b:=lookup[y,2];
  454.     c:=centre[loop1].x;
  455.     asm
  456.       mov   ax,b
  457.       imul  c
  458.       sal   ax,1
  459.       rcl   dx,1
  460.       sal   ax,1
  461.       rcl   dx,1
  462.       mov   a,dx
  463.     end;
  464.     b:=lookup[y,1];
  465.     c:=centre[loop1].z;
  466.     asm
  467.       mov   ax,b
  468.       imul  c
  469.       sal   ax,1
  470.       rcl   dx,1
  471.       sal   ax,1
  472.       rcl   dx,1
  473.       add   a,dx
  474.     end;
  475.     tcentre[loop1].x:=a;
  476.     tcentre[loop1].y:=centre[loop1].y;
  477.     b:=-lookup[y,1];
  478.     c:=centre[loop1].x;
  479.     asm
  480.       mov   ax,b
  481.       imul  c
  482.       sal   ax,1
  483.       rcl   dx,1
  484.       sal   ax,1
  485.       rcl   dx,1
  486.       mov   a,dx
  487.     end;
  488.     b:=lookup[y,2];
  489.     c:=centre[loop1].z;
  490.     asm
  491.       mov   ax,b
  492.       imul  c
  493.       sal   ax,1
  494.       rcl   dx,1
  495.       sal   ax,1
  496.       rcl   dx,1
  497.       add   a,dx
  498.     end;
  499.     tcentre[loop1].z:=a;
  500.  
  501.  
  502.     if x<>0 then BEGIN
  503.       b:=lookup[x,2];
  504.       c:=tcentre[loop1].y;
  505.       asm
  506.         mov   ax,b
  507.         imul  c
  508.         sal   ax,1
  509.         rcl   dx,1
  510.         sal   ax,1
  511.         rcl   dx,1
  512.         mov   a,dx
  513.       end;
  514.       b:=lookup[x,1];
  515.       c:=tcentre[loop1].z;
  516.       asm
  517.         mov   ax,b
  518.         imul  c
  519.         sal   ax,1
  520.         rcl   dx,1
  521.         sal   ax,1
  522.         rcl   dx,1
  523.         sub   a,dx
  524.       end;
  525.       b:=lookup[x,1];
  526.       c:=tcentre[loop1].y;
  527.       tcentre[loop1].y:=a;
  528.       asm
  529.         mov   ax,b
  530.         imul  c
  531.         sal   ax,1
  532.         rcl   dx,1
  533.         sal   ax,1
  534.         rcl   dx,1
  535.         mov   a,dx
  536.       end;
  537.       b:=lookup[x,2];
  538.       c:=tcentre[loop1].z;
  539.       asm
  540.         mov   ax,b
  541.         imul  c
  542.         sal   ax,1
  543.         rcl   dx,1
  544.         sal   ax,1
  545.         rcl   dx,1
  546.         add   a,dx
  547.       end;
  548.       tcentre[loop1].z:=a;
  549.     END;
  550.  
  551.  
  552.  
  553.  
  554.     if z<>0 then BEGIN
  555.       b:=lookup[z,2];
  556.       c:=tcentre[loop1].x;
  557.       asm
  558.         mov   ax,b
  559.         imul  c
  560.         sal   ax,1
  561.         rcl   dx,1
  562.         sal   ax,1
  563.         rcl   dx,1
  564.         mov   a,dx
  565.       end;
  566.       b:=lookup[z,1];
  567.       c:=tcentre[loop1].y;
  568.       asm
  569.         mov   ax,b
  570.         imul  c
  571.         sal   ax,1
  572.         rcl   dx,1
  573.         sal   ax,1
  574.         rcl   dx,1
  575.         sub   a,dx
  576.       end;
  577.       b:=lookup[z,1];
  578.       c:=tcentre[loop1].x;
  579.       tcentre[loop1].x:=a;
  580.       asm
  581.         mov   ax,b
  582.         imul  c
  583.         sal   ax,1
  584.         rcl   dx,1
  585.         sal   ax,1
  586.         rcl   dx,1
  587.         mov   a,dx
  588.       end;
  589.       b:=lookup[z,2];
  590.       c:=tcentre[loop1].y;
  591.       asm
  592.         mov   ax,b
  593.         imul  c
  594.         sal   ax,1
  595.         rcl   dx,1
  596.         sal   ax,1
  597.         rcl   dx,1
  598.         add   a,dx
  599.       end;
  600.       tcentre[loop1].y:=a;
  601.     END;
  602.   END;
  603. END;
  604.  
  605.  
  606. Procedure TextureMapPoly (x1,y1,x2,y2,x3,y3,x4,y4:integer;where:word);
  607.   { The main procedure, contains various nested procedures }
  608. VAR miny, maxy, loop1 : integer;
  609.  
  610. Procedure scanleftside (x1,x2,ytop,lineheight:integer;side:byte);
  611.   { Scan in our needed variables ... X on the left, texturmap X, texturemap Y}
  612. VAR x,px,py,xadd,pxadd,pyadd:integer;
  613.     y:integer;
  614. BEGIN
  615.   lineheight:=lineheight+1;
  616.   xadd:=(x2-x1) shl 7 div lineheight;
  617.   if side = 1 then BEGIN
  618.     px:=(127-1) shl 7;
  619.     py:=0;
  620.     pxadd:=(-127 shl 7) div lineheight;
  621.     pyadd:=0;
  622.   END;
  623.   if side = 2 then BEGIN
  624.     px:=127 shl 7;
  625.     py:=127 shl 7;
  626.     pxadd:=0;
  627.     pyadd:=(-127 shl 7) div lineheight;
  628.   END;
  629.   if side = 3 then BEGIN
  630.     px:=0;
  631.     py:=127 shl 7;
  632.     pxadd:=127 shl 7 div lineheight;
  633.     pyadd:=0;
  634.   END;
  635.   if side = 4 then BEGIN
  636.     px:=0;
  637.     py:=0;
  638.     pxadd:=0;
  639.     pyadd:=127 shl 7 div lineheight;
  640.   END;
  641.   x:=x1 shl 7;
  642.   for y:=0 to lineheight do BEGIN
  643.     lefttable[ytop+y,0]:=x shr 7;
  644.     lefttable[ytop+y,1]:=px shr 7;
  645.     lefttable[ytop+y,2]:=py shr 7;
  646.     x:=x+xadd;
  647.     px:=px+pxadd;
  648.     py:=py+pyadd;
  649.   END;
  650. END;
  651.  
  652. Procedure scanrightside (x1,x2,ytop,lineheight:integer;side:byte);
  653.   { Scan in our needed variables ... X on the right, texturmap X, texturemap Y}
  654. VAR x,px,py,xadd,pxadd,pyadd:integer;
  655.     y:integer;
  656. BEGIN
  657.   lineheight:=lineheight+1;
  658.   xadd:=(x2-x1) shl 7 div lineheight;
  659.   if side = 1 then BEGIN
  660.     px:=0;
  661.     py:=0;
  662.     pxadd:=127 shl 7 div lineheight;
  663.     pyadd:=0;
  664.   END;
  665.   if side = 2 then BEGIN
  666.     px:=127 shl 7;
  667.     py:=0;
  668.     pxadd:=0;
  669.     pyadd:=127 shl 7 div lineheight;
  670.   END;
  671.   if side = 3 then BEGIN
  672.     px:=127 shl 7;
  673.     py:=127 shl 7;
  674.     pxadd:=(-127) shl 7 div lineheight;
  675.     pyadd:=0;
  676.   END;
  677.   if side = 4 then BEGIN
  678.     px:=0;
  679.     py:=127 shl 7;
  680.     pxadd:=0;
  681.     pyadd:=(-127) shl 7 div lineheight;
  682.   END;
  683.   x:=x1 shl 7;
  684.   for y:=0 to lineheight do BEGIN
  685.     righttable[ytop+y,0]:=x shr 7;
  686.     righttable[ytop+y,1]:=px shr 7;
  687.     righttable[ytop+y,2]:=py shr 7;
  688.     x:=x+xadd;
  689.     px:=px+pxadd;
  690.     py:=py+pyadd;
  691.   END;
  692. END;
  693.  
  694.  
  695. Procedure Texturemap;
  696.   { This uses the tables we have created to actually draw the texture }
  697. VAR px1,py1:integer;
  698.     px2,py2:integer;
  699.     polyx1,polyx2,y,linewidth:integer;
  700.     pxadd,pyadd:integer;
  701.     bob, twhere :word;
  702. BEGIN
  703.   bob:=seg (pic^);
  704.   tWhere := Where;      { ds is used elsewhere ... variables are not accessable }
  705.   if miny<0 then miny:=0;
  706.   if maxy>199 then maxy:=199;
  707.   if miny<ytopclip then miny:=ytopclip;
  708.   if maxy>ybotclip then maxy:=ybotclip;
  709.   if maxy-miny<2 then exit;
  710.   if miny>199 then exit;
  711.   if maxy<0 then exit;
  712.   for y:=miny to maxy do BEGIN
  713.     polyx1:=lefttable[y,0];      { X Starting position }
  714.     px1:=lefttable[y,1] shl 7;   { Texture X at start  }
  715.     py1:=lefttable[y,2] shl 7;   { Texture Y at stary  }
  716.     polyx2:=righttable[y,0];     { X Ending position   }
  717.     px2:=righttable[y,1] shl 7;  { Texture X at end    }
  718.     py2:=righttable[y,2] shl 7;  { Texture Y at end    }
  719.     linewidth:=polyx2-polyx1;    { Width of line }
  720.     if linewidth<=0 then linewidth:=1;
  721.     pxadd:=(px2-px1) div linewidth;
  722.     pyadd:=(py2-py1) div linewidth;
  723.       asm
  724.         push    ds
  725.         mov     bx,polyx1
  726.         mov     di,bx
  727.  
  728.         mov     dx,[Y]
  729.         mov     bx, dx
  730.         shl     dx, 8
  731.         shl     bx, 6
  732.         add     dx, bx
  733.         add     di, dx
  734.         mov     ax,twhere        { es:di points to start of line }
  735.         mov     es,ax
  736.  
  737.         mov     bx, px1
  738.  
  739.         mov     cx,lineWidth
  740.         mov     dx, bob
  741.         mov     ds, dx
  742.  
  743.         mov     dx,py1
  744. @Loop1 :
  745.         xor     si,si
  746.         mov     ax,bx
  747.         and     ax,1111111110000000b;   { Get rid of fixed point }
  748.         add     si,ax
  749.         mov     ax,dx
  750.         shr     ax,7
  751.         add     si,ax           { get the pixel in our texture }
  752.         movsb                   { draw the pixel to the screen }
  753.         mov     ax,pxadd
  754.         add     bx,ax
  755.         mov     ax,pyadd
  756.         add     dx,ax           { increment our position in the texture }
  757.         loop    @loop1
  758.         pop     ds
  759.       end;
  760.   END;
  761. END;
  762.  
  763. BEGIN
  764.   miny:=32767;
  765.   maxy:=0;
  766.  
  767.   if y1<miny then miny:=y1;
  768.   if y1>maxy then maxy:=y1;
  769.   if y2<miny then miny:=y2;
  770.   if y2>maxy then maxy:=y2;
  771.   if y3<miny then miny:=y3;
  772.   if y3>maxy then maxy:=y3;
  773.   if y4<miny then miny:=y4;
  774.   if y4>maxy then maxy:=y4;
  775.  
  776.   if miny>maxy-5 then exit;     { Why paint slivers? }
  777.  
  778.   if (y2<y1) then
  779.     scanleftside (x2,x1,y2,y1-y2,1)
  780.   else
  781.     scanrightside (x1,x2,y1,y2-y1,1);
  782.   { If point2.y is above point1.y, Point1 to Point2 is on the "left",
  783.     and our leftside array must be altered }
  784.  
  785.   if (y3<y2) then
  786.     scanleftside (x3,x2,y3,y2-y3,2)
  787.   else
  788.     scanrightside (x2,x3,y2,y3-y2,2);
  789.  
  790.   if (y4<y3) then
  791.     scanleftside (x4,x3,y4,y3-y4,3)
  792.   else
  793.     scanrightside (x3,x4,y3,y4-y3,3);
  794.  
  795.   if (y1<y4) then
  796.     scanleftside (x1,x4,y1,y4-y1,4)
  797.   else
  798.     scanrightside (x4,x1,y4,y1-y4,4);
  799.  
  800.   texturemap;
  801. END;
  802.  
  803.  
  804.  
  805. {──────────────────────────────────────────────────────────────────────────}
  806. Procedure DrawPoints;
  807.   { This draws the translated object to the virtual screen }
  808. VAR loop1,loop2:Integer;
  809.     temp, normal:integer;
  810.     nx:integer;
  811.     tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4:integer;
  812. BEGIN
  813.   For loop2:=1 to maxpolys do BEGIN
  814.     loop1:=order[loop2];
  815.     If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].z+zoff<0)
  816.        and (translated[loop1,3].z+zoff<0) and (translated[loop1,4].z+zoff<0)
  817.        then BEGIN
  818.       temp:=round (translated[loop1,1].z)+zoff;
  819.       nx:=translated[loop1,1].X;
  820.       asm
  821.         mov   ax,nx
  822.         mov   dx,ax
  823.         sal   ax,8
  824.         sar   dx,8
  825.         idiv  temp
  826.         add   ax,YOfs
  827.         mov   nx,ax
  828.       end;
  829.       tx1:=nx;
  830.       nx:=translated[loop1,1].Y;
  831.       asm
  832.         mov   ax,nx
  833.         mov   dx,ax
  834.         sal   ax,8
  835.         sar   dx,8
  836.         idiv  temp
  837.         add   ax,XOfs
  838.         mov   nx,ax
  839.       end;
  840.       ty1:=nx;
  841.  
  842.  
  843.       temp:=round (translated[loop1,2].z)+zoff;
  844.       nx:=translated[loop1,2].X;
  845.       asm
  846.         mov   ax,nx
  847.         mov   dx,ax
  848.         sal   ax,8
  849.         sar   dx,8
  850.         idiv  temp
  851.         add   ax,YOfs
  852.         mov   nx,ax
  853.       end;
  854.       tx2:=nx;
  855.       nx:=translated[loop1,2].Y;
  856.       asm
  857.         mov   ax,nx
  858.         mov   dx,ax
  859.         sal   ax,8
  860.         sar   dx,8
  861.         idiv  temp
  862.         add   ax,XOfs
  863.         mov   nx,ax
  864.       end;
  865.       ty2:=nx;
  866.  
  867.  
  868.       temp:=round (translated[loop1,3].z)+zoff;
  869.       nx:=translated[loop1,3].X;
  870.       asm
  871.         mov   ax,nx
  872.         mov   dx,ax
  873.         sal   ax,8
  874.         sar   dx,8
  875.         idiv  temp
  876.         add   ax,YOfs
  877.         mov   nx,ax
  878.       end;
  879.       tx3:=nx;
  880.       nx:=translated[loop1,3].Y;
  881.       asm
  882.         mov   ax,nx
  883.         mov   dx,ax
  884.         sal   ax,8
  885.         sar   dx,8
  886.         idiv  temp
  887.         add   ax,XOfs
  888.         mov   nx,ax
  889.       end;
  890.       ty3:=nx;
  891.  
  892.  
  893.       temp:=round (translated[loop1,4].z)+zoff;
  894.       nx:=translated[loop1,4].X;
  895.       asm
  896.         mov   ax,nx
  897.         mov   dx,ax
  898.         sal   ax,8
  899.         sar   dx,8
  900.         idiv  temp
  901.         add   ax,YOfs
  902.         mov   nx,ax
  903.       end;
  904.       tx4:=nx;
  905.       nx:=translated[loop1,4].Y;
  906.       asm
  907.         mov   ax,nx
  908.         mov   dx,ax
  909.         sal   ax,8
  910.         sar   dx,8
  911.         idiv  temp
  912.         add   ax,XOfs
  913.         mov   nx,ax
  914.       end;
  915.       ty4:=nx;
  916.  
  917.       normal:=(ty1-ty3)*(tx2-tx1)-(tx1-tx3)*(ty2-ty1);
  918.       if normal<0 then
  919.         TextureMapPoly (tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4,vaddr);
  920. {        drawpoly (tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4,loop1,vaddr);}
  921.     END;
  922.   END;
  923. END;
  924.  
  925.  
  926.  
  927. {──────────────────────────────────────────────────────────────────────────}
  928. Procedure SortPoints;
  929. VAR loop1,curpos, temp:integer;
  930. BEGIN
  931.   for loop1:=1 to maxpolys do BEGIN
  932.     order[loop1]:=loop1;
  933.   END;
  934.   curpos := 1;
  935.   while curpos<maxpolys do BEGIN
  936.     if tcentre[curpos].z > tcentre[curpos+1].z then BEGIN
  937.       temp := tcentre[curpos+1].x;
  938.       tcentre[curpos+1].x := tcentre[curpos].x;
  939.       tcentre[curpos].x := temp;
  940.  
  941.       temp := tcentre[curpos+1].y;
  942.       tcentre[curpos+1].y := tcentre[curpos].y;
  943.       tcentre[curpos].y := temp;
  944.  
  945.       temp := tcentre[curpos+1].z;
  946.       tcentre[curpos+1].z := tcentre[curpos].z;
  947.       tcentre[curpos].z := temp;
  948.  
  949.       temp := order[curpos+1];
  950.       order[curpos+1] := order[curpos];
  951.       order[curpos] := temp;
  952.  
  953.       curpos:=0;
  954.     END;
  955.     curpos:=curpos+1;
  956.   END;
  957. END;
  958.  
  959.  
  960. {──────────────────────────────────────────────────────────────────────────}
  961. Procedure MoveAround;
  962.   { This is the main display procedure. }
  963. VAR deg,deg2,loop1,loop2:integer;
  964.     ch:char;
  965.  
  966. BEGIN
  967.   pal (1,  0, 0,63);
  968.   pal (2,  0,32,63);
  969.   pal (3, 32, 0,63);
  970.   pal (4, 32,32,63);
  971.   pal (5,  0,63,63);
  972.   pal (6, 32,63,63);
  973.  
  974.   pal ( 7,  0,63, 0);
  975.   pal ( 8,  0,63,32);
  976.   pal ( 9, 32,63, 0);
  977.   pal (10, 32,63,32);
  978.   pal (11,  0,63,63);
  979.   pal (12, 32,63,63);
  980.  
  981.   pal (13, 63, 0, 0);
  982.   pal (14, 63,32, 0);
  983.   pal (15, 63, 0,32);
  984.   pal (16, 63,32,32);
  985.   pal (17, 63,63, 0);
  986.   pal (18, 63,63,32);
  987. {  for loop1:=1 to 15 do
  988.     pal (loop1,0,loop1*4+3,63-(loop1*4+3));}
  989.   pal (100,50,50,50);
  990.  
  991.   deg:=0;
  992.   deg2:=0;
  993.   ch:=#0;
  994.   Cls (vaddr,0);
  995.   For loop1:=1 to maxpolys do
  996.     For loop2:=1 to 4 do BEGIN
  997.       Lines [loop1,loop2].x:=a [loop1,loop2,1]*8;
  998.       Lines [loop1,loop2].y:=a [loop1,loop2,2]*8;
  999.       Lines [loop1,loop2].z:=a [loop1,loop2,3]*8;
  1000.     END;
  1001.  
  1002.   SetUpPoints;
  1003.   LoadGFX;
  1004.  
  1005.   cls (vaddr,0);
  1006.   cls (vga,0);
  1007.   Xoff := 160;
  1008.   Yoff:=100;
  1009.   zoff:=-600;
  1010.  
  1011.   ytopclip:=101;
  1012.   ybotclip:=100;
  1013.   line (0,100,319,100,100,vga);
  1014.   delay (2000);
  1015.   for loop1:=1 to 25 do BEGIN
  1016.     RotatePoints (deg2,deg,deg2);
  1017.     SortPoints;
  1018.     DrawPoints;
  1019.     line (0,ytopclip,319,ytopclip,100,vaddr);
  1020.     line (0,ybotclip,319,ybotclip,100,vaddr);
  1021.     flip (vaddr,vga);
  1022.     cls (vaddr,0);
  1023.     deg:=(deg+5) mod 360;
  1024.     deg2:=(deg2+1) mod 360;
  1025.     ytopclip:=ytopclip-4;
  1026.     ybotclip:=ybotclip+4;
  1027.   END;
  1028.   Repeat
  1029.     if keypressed then ch:=upcase (Readkey);
  1030.     RotatePoints (deg2,deg,deg2);
  1031.     SortPoints;
  1032.     DrawPoints;
  1033.     line (0,0,319,0,100,vaddr);
  1034.     line (0,199,319,199,100,vaddr);
  1035.     flip (vaddr,vga);
  1036.     cls (vaddr,0);
  1037.     deg:=(deg+5) mod 360;
  1038.     deg2:=(deg2+3) mod 360;
  1039.   Until ch=#27;
  1040.   for loop1:=1 to 25 do BEGIN
  1041.     ytopclip:=ytopclip+4;
  1042.     ybotclip:=ybotclip-4;
  1043.     RotatePoints (deg2,deg,deg2);
  1044.     SortPoints;
  1045.     DrawPoints;
  1046.     line (0,ytopclip,319,ytopclip,100,vaddr);
  1047.     line (0,ybotclip,319,ybotclip,100,vaddr);
  1048.     flip (vaddr,vga);
  1049.     cls (vaddr,0);
  1050.     deg:=(deg+5) mod 360;
  1051.     deg2:=(deg2+1) mod 360;
  1052.   END;
  1053. END;
  1054.  
  1055.  
  1056. BEGIN
  1057.   clrscr;
  1058.   writeln ('Welcome to the twenty first trainer! This one is on texure mapping.');
  1059.   writeln;
  1060.   writeln ('Just sit bak and watch, it''s non interactive. Total reuse of Tut 20''s');
  1061.   writeln ('code, aside from the texure mapping procedure. Have fun!');
  1062.   writeln;
  1063.   writeln;
  1064.   write ('Hit any key to continue ...');
  1065.   readkey;
  1066.   SetUpVirtual;
  1067.   SetMCGA;
  1068.   MoveAround;
  1069.   SetText;
  1070.   ShutDown;
  1071.   Writeln ('All done. This concludes the twenty first sample program in the ASPHYXIA');
  1072.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  1073.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally');
  1074.   Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
  1075.   Writeln ('    denthor@goth.vironix.co.za');
  1076.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  1077.   Writeln ('             Grant Smith');
  1078.   Writeln ('             P.O. Box 270');
  1079.   Writeln ('             Kloof');
  1080.   Writeln ('             3640');
  1081.   Writeln ('             Natal');
  1082.   Writeln ('             South Africa');
  1083.   Writeln ('I hope to hear from you soon!');
  1084.   Writeln; Writeln;
  1085.   Write   ('Hit any key to exit ...');
  1086.   readkey;
  1087. END.
  1088.